perm filename PAKTST.OLD[M11,LCS] blob
sn#406213 filedate 1978-12-28 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 DIMENSION INP(80)
C00004 ENDMK
Cā;
DIMENSION INP(80)
DATA IBLA/' '/,ISEMI/';'/
888 FORMAT(80A1)
889 FORMAT(1XA5)
890 FORMAT(' TYPE'/)
891 FORMAT(1X80A1)
5 TYPE 890
ACCEPT 888,INP
DO 1 J=1,80
1 IF(INP(J).EQ.IBLA.OR.INP(J).EQ.ISEMI)GO TO 2
2 JJ=J
J=J-1
N=J
IF(J.GT.5)N=4
DO 3 M=80,1,-1
3 IF(INP(M).NE.IBLA)GO TO 4
GO TO 5
4 CALL PACKER(NN,INP,N)
C NN BRINGS BACK PACKED NAME, INP IS ARRAY, N IS WDCNT.
TYPE 889,NN
70 DO 7 I=1,M-JJ
7 INP(I)=INP(I+JJ)
DO 8 I=M-J,M
8 INP(I)=IBLA
M=M-JJ
TYPE 891,(INP(K),K=1,M)
END
SUBROUTINE PACKER(NN,JNM,N)
DIMENSION JNM(1),KNM(5)
DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
DATA MM/"774000000000/,IBLA/' '/
DO 10 K=1,5
IF(K.GT.N)GO TO 11
KNM(K)=JNM(K)
GO TO 10
11 KNM(K)=IBLA
10 CONTINUE
C N=WDCNT OF INST NAME
NN=0
DO 12 K=5,1,-1
NN=NN .OR. (KNM(K) .AND. MM)
IF (K.EQ.1)RETURN
17 IF (NN.GE.0)GO TO 13
NN = (( NN .AND. LL)/KK) .OR. JJ
GO TO 12
13 NN = NN / KK
12 CONTINUE
END